home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1993 July / InfoMagic USENET CD-ROM July 1993.ISO / sources / misc / volume22 / perl_archie / part01 next >
Encoding:
Text File  |  1991-08-25  |  57.3 KB  |  1,865 lines

  1. Newsgroups: comp.sources.misc
  2. From: Khun Yee Fung <clipper@csd.uwo.ca>
  3. Subject:  v22i061:  perl_archie - an archie client in perl, Part01/01
  4. Message-ID: <1991Aug25.223459.12192@sparky.IMD.Sterling.COM>
  5. X-Md4-Signature: 63e8d5c233dc59589d193f222fde4f93
  6. Date: Sun, 25 Aug 1991 22:34:59 GMT
  7. Approved: kent@sparky.imd.sterling.com
  8.  
  9. Submitted-by: Khun Yee Fung <clipper@csd.uwo.ca>
  10. Posting-number: Volume 22, Issue 61
  11. Archive-name: perl_archie/part01
  12. Environment: BSD, Perl
  13.  
  14. This version is 3.8. Please do not use version 2.x of the perl client
  15. posted in alt.sources as it is now obselete.
  16.  
  17. This is an implementation of an archie client in the perl language. It
  18. is written such that there is no dependancy on the prospero package
  19. available from june.cs.washington.edu, prospero.tar.Z. As it is
  20. written in Perl, it is easy to modify the client to your own need.
  21. Also, the format for the output can be specified by the user. As you
  22. query the archie server machine without a shell connection, the
  23. response is quicker, and the result easier to handle.
  24.  
  25. Please read the README for more details and the man page for
  26. instruction for using the client. The file archie.examples has a few
  27. examples.
  28.  
  29. Please notice that there are two archie clients in C. One is included
  30. in the prospero distribution. The other is written by Brendan Kehoe. A
  31. X-based archie client is also coming.
  32.  
  33. Comments, etc. are welcome. Please send them to clipper@csd.uwo.ca.
  34.  
  35. Khun Yee
  36. --
  37. #! /bin/sh
  38. # This is a shell archive.  Remove anything before this line, then unpack
  39. # it by saving it into a file and typing "sh file".  To overwrite existing
  40. # files, type "sh file -c".  You can also feed this as standard input via
  41. # unshar, or by typing "sh <file", e.g..  If this archive is complete, you
  42. # will see the following message at the end:
  43. #        "End of shell archive."
  44. # Contents:  README ACKNOWLEDGE Makefile fixpath archie.files archie
  45. #   archie.l socket.ph resolver.pl newgetopt.pl archie.depend
  46. #   archie.examples DOT.archierc system.archierc
  47. # Wrapped by clipper@no9sun on Thu Aug 22 02:04:24 1991
  48. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  49. if test -f 'README' -a "${1}" != "-c" ; then 
  50.   echo shar: Will not clobber existing file \"'README'\"
  51. else
  52. echo shar: Extracting \"'README'\" \(5726 characters\)
  53. sed "s/^X//" >'README' <<'END_OF_FILE'
  54. X# Copyright (C) Khun Yee Fung clipper@csd.uwo.ca 1991
  55. X# You can do anything to this program except selling it for profit or
  56. X# pretending you wrote it.
  57. X# $Id: README,v 3.6 1991/08/03 00:15:22 clipper Exp clipper $
  58. X
  59. XThis README file is for version 3.x of the archie program.
  60. X
  61. XNew
  62. X---
  63. X
  64. XI forgot to include fixpath and Makefile in the last distribution.
  65. XSorry. They are now included.
  66. X
  67. XChanges for Version 3.6
  68. X-----------------------
  69. X
  70. X1. The -along option is on again. This option is useful for at least
  71. Xone person and I think is useful if the query dies in midway. At least
  72. Xa partial result is better than nothing.
  73. X
  74. X2. Some other small changes are done.
  75. X
  76. X3. Some details in the man page are changed.
  77. X
  78. X4. Consider this a gamma release.
  79. X
  80. XChanges since version 2.xx
  81. X--------------------------
  82. X
  83. X  1. A sort option is added. The lists can be sorted by the domain of
  84. X  the host or by the date. Reverse ordering is supported too. The host
  85. X  ordering is by a user definable array. This is useful if the list
  86. X  has the domains in order of nearest to farthest from the system the
  87. X  user is using. Check  system.archierc to set the system default ordering.
  88. X
  89. X  2. Version option is supported. When this option is specified, the
  90. X  version number of the program will be printed.
  91. X
  92. X  3. A different startup file can be specified.
  93. X
  94. X  4. I have decided not to do packet ordering myself. So the -along
  95. X  option is gone.
  96. X
  97. X  5. The part on networking has been completely rewritten. I hope it
  98. X  is more correct than the last two releases.
  99. X
  100. X  6. There are other small changes. I can't list them all.
  101. X
  102. XI will not add any more features in the program. It is too big even now.
  103. X
  104. XFeature not implemented
  105. X-----------------------
  106. X
  107. X  I have thought about implementing a auto-ftp option in the program
  108. X  so that the program will ask the user if a file should be transferred
  109. X  from the host by anonymous ftp. I have all the code for a ftp client
  110. X  in perl (I have always used this perl ftp than the standard ftp). I
  111. X  have thought out how it should be implemented. The host sorting
  112. X  method was thought out initially to support this option so that the
  113. X  nearest hosts are always asked first. But the option will add
  114. X  another 10k bytes to the program. I am not happy about the size of
  115. X  the program even now. As we can always set the format of the output
  116. X  to a particular format and pipe the output to another program for
  117. X  anonymous ftp, I have decided against implementing this feature. If
  118. X  you want to implement it, I can supply you the perl ftp client code.
  119. X
  120. XBrief Introduction
  121. X------------------
  122. X
  123. XThis is a archie client written in Perl using the prospero protocol.
  124. XIt is standalone with no dependance on the prospero code in
  125. Xprospero.tar.Z on june.cs.washington.edu. I am not sure this program
  126. Xis useful as there is also a standalone archie program in that file
  127. Xarchive, except that you have to compile the prospero file system too.
  128. XSo, if you think you are more interested in a C archie client, do grab
  129. Xthat file archive and install the archie client that comes with it.
  130. X
  131. XTo get more information about prospero, you can send a message to
  132. Xinfo-prospero@isi.edu.
  133. X
  134. XAbout Prospero
  135. X--------------
  136. X
  137. XWith prospero, many things that are tedious to do by login
  138. Xinteractively to an archie server are simple. For example, the output
  139. Xfrom an archie client using the prospero protocol can be parsed and
  140. Xfurther processed without going through the mail system. The system
  141. Xload on the archie server will surely lower because of the absence of
  142. Xinteractive processes. The attributes of a directory or a file also
  143. Xmakes the output look like a part of a file system.
  144. X
  145. XSystem Requirements
  146. X-------------------
  147. X
  148. X  1. The program probably needs Perl 4.010. Perl 3.044 causes it to
  149. X  core dump.
  150. X
  151. XInstallation
  152. X------------
  153. X
  154. XTo start things off, modify the file archie.depend. You should also
  155. Xmove archie in the directory where you store you perl scripts. The
  156. Xlibrary files should be in the perl library. If you want to, you can
  157. Xuse the Makefile in this distribution.
  158. X
  159. XPlease also check the file system.archierc. Change the sorting order
  160. Xof hosts in the domain option. Put the domains nearest to your site in
  161. Xthe beginning of the option and farthest at the end. For a site in
  162. XFinland, probably the order is very different, with .de .nl.dk nearer
  163. Xto the beginning of the list than .ca, .edu, .com, or .ca.
  164. X
  165. XAcknowledgement file
  166. X--------------------
  167. X
  168. XI guess I know the header information much better now. The program has
  169. Xbeen modified. Thanks very much to Clifford Neuman
  170. X(bcn@cs.washington.edu) for providing information on prospero. Please
  171. Xread ACKNOWLEDGE for acknowledgements.
  172. X
  173. XStatus of the program
  174. X---------------------
  175. X
  176. XThis program is in the gamma testing stage.  However, I will not add
  177. Xany more features. Also, I will only modify the file to correct bugs.
  178. XThis is basically a stable version.  I need people to test, improve,
  179. Xand suggest, to make it better.  It is written on a Sun 3/50.  I tried
  180. Xit on a MIPS RISC/os 4.51. It worked. I have also tried it on a
  181. XSequent symmetry Dynix Version something. These are the machines that
  182. XI have access to.  Brendan Kehoe reports that it works under some
  183. XHP's, an Encore, and DecStations too.  Peter (poe@daimi.aau.dk) says
  184. Xit works on his HP9000/300 under HP-UX 7.0 too. Billy Barron says it
  185. Xworks under Solbourne OS/MP 4.0D.  It might not work on other
  186. Xmachines.  If you port it to another machine type, please send me the
  187. Xdiffs, thanks. If you find bugs on other machine types, please also
  188. Xtell me. I would like to know how portable the program is.
  189. X
  190. XOthers
  191. X------
  192. X
  193. XPlease send your comments, criticisms, diffs, bug reports, etc. to me
  194. Xat clipper@csd.uwo.ca. Yes, you can even criticise my programming
  195. Xstyle.
  196. X
  197. XKhun Yee
  198. XAugust 2
  199. END_OF_FILE
  200. if test 5726 -ne `wc -c <'README'`; then
  201.     echo shar: \"'README'\" unpacked with wrong size!
  202. fi
  203. # end of 'README'
  204. fi
  205. if test -f 'ACKNOWLEDGE' -a "${1}" != "-c" ; then 
  206.   echo shar: Will not clobber existing file \"'ACKNOWLEDGE'\"
  207. else
  208. echo shar: Extracting \"'ACKNOWLEDGE'\" \(1631 characters\)
  209. sed "s/^X//" >'ACKNOWLEDGE' <<'END_OF_FILE'
  210. XSince the program is getting more stable by the day, it is time I add
  211. Xa little file to acknowledge people that have helped me along the way.
  212. X
  213. XForemost, Clifford Neuman (bcn@cs.washington.edu) provides us with the
  214. Xprospero protocol. This makes the whole thing possible. He provided
  215. Xall the information I used concerning the prospero protocol.  Without
  216. Xhis help, this program is impossible.  As I wrote the program at the
  217. Xtime the protocol was being updated, I thank him for providing me all
  218. Xthe information when it came along. He also informed me of a test
  219. Xarchie server that I used to eliminate many bugs.  I am grateful for all
  220. Xhis helps.
  221. X
  222. XTo the people in quiche.cs.mcgill.ca providing archie, it is certainly
  223. Xhard to imagine the days when archie was not available.
  224. X
  225. XTo all the people who sent me messages telling me the problems they
  226. Xencountered, telling me that the program worked on their machines,
  227. Xand telling me the program did not work on their machines, I thank you
  228. Xvery much. These people are:
  229. X
  230. XGary D. Kline, ssi!gdk@uunet.uu.net
  231. XEmmett Hogan, hogan@csl.sri.com
  232. XKarsten Thygesen, karthy@iesd.auc.dk
  233. XBrendan Kehoe, brendan@cs.widener.edu
  234. XPeter Mutsaiers, muts@fysak.fys.ruu.nl
  235. XKean Stump, kean@ucs.orst.edu            # thanks for providing a Makefile
  236. XPeter Orbaek, poe@daimi.aau.dk           # thanks for making it more perl'ish
  237. XBilly Barron, billy@sol.acs.unt.edu
  238. X
  239. XI may have missed one or two people. To them, I am sorry.
  240. X
  241. XI know the program is rather trivial and not even useful for many
  242. Xpeople. But I wrote in the hope that it might be useful for a few
  243. Xpeople. I posted it in the Usenet spirit of sharing.
  244. X
  245. XKhun Yee
  246. END_OF_FILE
  247. if test 1631 -ne `wc -c <'ACKNOWLEDGE'`; then
  248.     echo shar: \"'ACKNOWLEDGE'\" unpacked with wrong size!
  249. fi
  250. # end of 'ACKNOWLEDGE'
  251. fi
  252. if test -f 'Makefile' -a "${1}" != "-c" ; then 
  253.   echo shar: Will not clobber existing file \"'Makefile'\"
  254. else
  255. echo shar: Extracting \"'Makefile'\" \(636 characters\)
  256. sed "s/^X//" >'Makefile' <<'END_OF_FILE'
  257. X# From kean@argh.ucs.orst.edu (Kean Stump) with the fixpath line
  258. X# added by me.
  259. X# Change the following two lines if you are not sysadmin.
  260. XOWNER=bin
  261. XGROUP=bin
  262. XLIB=resolver.pl archie.depend newgetopt.pl
  263. XBIN=archie
  264. XMAN=archie.l
  265. XSTARTUP=system.archierc
  266. XBINDIR=/usr/local/bin
  267. XLIBDIR=/usr/local/lib/perl
  268. XMANDIR=/usr/local/man/man1
  269. XSTARTUPDIR=/usr/local/lib
  270. X
  271. Xinstall: 
  272. X    perl fixpath $(BINDIR)/perl
  273. X    install -o $(OWNER) -g $(GROUP) -m 755 $(BIN) $(BINDIR)
  274. X    install -o $(OWNER) -g $(GROUP) -m 444 $(LIB) $(LIBDIR)
  275. X    install -o $(OWNER) -g $(GROUP) -m 444 $(MAN) $(MANDIR)/archie.1
  276. X    install -o $(OWNER) -g $(GROUP) -m 444 $(STARTUP) $(STARTUPDIR)
  277. END_OF_FILE
  278. if test 636 -ne `wc -c <'Makefile'`; then
  279.     echo shar: \"'Makefile'\" unpacked with wrong size!
  280. fi
  281. # end of 'Makefile'
  282. fi
  283. if test -f 'fixpath' -a "${1}" != "-c" ; then 
  284.   echo shar: Will not clobber existing file \"'fixpath'\"
  285. else
  286. echo shar: Extracting \"'fixpath'\" \(297 characters\)
  287. sed "s/^X//" >'fixpath' <<'END_OF_FILE'
  288. X#!/u3/thesis/clipper/bin/perl
  289. Xeval "exec perl -S $0 $*"
  290. X    if $running_under_some_shell;
  291. Xrename("archie", "archie.ori");
  292. Xopen(FILE, "archie.ori");
  293. Xopen(OUT, ">archie");
  294. Xprint OUT "\#\!$ARGV[0]\n";
  295. Xprint $_ unless (!($_ = <FILE>) || ($_ =~ /^\#\!/));
  296. Xwhile (<FILE>) {
  297. X    print OUT $_;
  298. X}
  299. Xclose(OUT);
  300. END_OF_FILE
  301. if test 297 -ne `wc -c <'fixpath'`; then
  302.     echo shar: \"'fixpath'\" unpacked with wrong size!
  303. fi
  304. chmod +x 'fixpath'
  305. # end of 'fixpath'
  306. fi
  307. if test -f 'archie.files' -a "${1}" != "-c" ; then 
  308.   echo shar: Will not clobber existing file \"'archie.files'\"
  309. else
  310. echo shar: Extracting \"'archie.files'\" \(1058 characters\)
  311. sed "s/^X//" >'archie.files' <<'END_OF_FILE'
  312. Xarchie.files       -- this file.
  313. Xarchie             -- the program file. Remember to set to executable
  314. XREADME             -- the readme file for archie
  315. Xsocket.ph          -- Yours might be called sys/socket.ph. If so,
  316. X                      change the name in the file archie.depend. This file is
  317. X                      included only for completeness's sake.
  318. Xresolver.pl        -- a simple address resolver in perl. archie uses
  319. X                      gethostbyname() first before trying the
  320. X                      resolver. Do check the domain server name in the
  321. X                      resolver file.
  322. Xnewgetopt.pl       -- I got this from comp.lang.perl. A wonderful package.
  323. Xarchie.depend      -- System dependent stuff.
  324. Xarchie.l           -- A rudimentary manual page for archie.
  325. XDOT.archierc       -- An example .archirc file.
  326. Xarchie.examples    -- Some examples on using archie.
  327. Xfixpath            -- To fix the perl binary directory in archie.
  328. XMakefile           -- A simple install script for archie.
  329. Xsystem.archierc    -- A sample system archierc
  330. X
  331. XThanks.
  332. END_OF_FILE
  333. if test 1058 -ne `wc -c <'archie.files'`; then
  334.     echo shar: \"'archie.files'\" unpacked with wrong size!
  335. fi
  336. # end of 'archie.files'
  337. fi
  338. if test -f 'archie' -a "${1}" != "-c" ; then 
  339.   echo shar: Will not clobber existing file \"'archie'\"
  340. else
  341. echo shar: Extracting \"'archie'\" \(18760 characters\)
  342. sed "s/^X//" >'archie' <<'END_OF_FILE'
  343. X#!/u3/thesis/clipper/bin/perl
  344. X# Copyright (C) Khun Yee Fung clipper@csd.uwo.ca 1991
  345. X#
  346. X# Modified by Peter Orbaek (poe@daimi.aau.dk) to look more perl'ish.
  347. X#
  348. X# You can do anything to this program except selling it for profit or
  349. X# pretending you wrote it. The copyright notice must be preserved in all 
  350. X# copies. Absolutely no warranty.
  351. X#
  352. X# $Id: archie,v 3.8 1991/08/12 17:05:18 clipper Exp clipper $
  353. X#
  354. X# This version of the program is based on Beta 4.2 of prospero protocol.
  355. X# The Version number of this release is $Revision: 3.8 $.
  356. X
  357. Xeval "exec perl -S $0 $*"
  358. X    if $running_under_some_shell;
  359. X
  360. Xrequire 'resolver.pl';
  361. Xrequire 'sys/socket.ph';
  362. Xrequire 'newgetopt.pl';
  363. Xrequire 'archie.depend';
  364. X$servername =~ tr/A-Z/a-z/;
  365. X
  366. Xselect(STDOUT); $| = 1;
  367. X
  368. X# To get the options on the command line. Explanations are in the code
  369. X# handling them.
  370. X&NGetOpt('match=i', 'reg', 'exact', 'nocase', 'case', 'server=s',
  371. X     'ffile=s', 'format=s', 'along', 'norc', 'syntax', 'version',
  372. X     'sort=s', 'reverse', 'rc=s', 'domain=s', 'aftp');
  373. X
  374. X# Get the name of this program. The last element is the one.
  375. X@prog = split('/', $0);
  376. X$prog = $prog[$#prog];
  377. X
  378. X# Usage string.
  379. X# The options -syntax and -aftp are invisible because -syntax is used only
  380. X# to check the syntax of the program and -aftp is useful only for the archie
  381. X# interface of the nftp program.
  382. X$usage = 
  383. X"Usage: $prog [options] word1 word2 ...
  384. X  Where options are one or more of the following:
  385. X  -along            Print the entries when they are available.
  386. X  -case             Case sensitive
  387. X  -nocase           Case insensitive
  388. X  -exact            Exact match
  389. X  -reg              Regular expression match
  390. X  -match \#          Max hits
  391. X  -server hostname  An alternative archie server
  392. X  -ffile filename   Use a format file
  393. X  -format string    Specify a format string
  394. X  -norc             Do not read .archierc file in home directory.
  395. X  -version          Print the version number of the program.
  396. X  -rc filename      Read another file as the startup file.
  397. X  -sort [date|host] Sort by date ot host.
  398. X  -reverse          Reverse sorting order.
  399. X  -domain string    Use the order in the string to sort the hosts.
  400. X";
  401. X
  402. X($Revision) = ('$Revision: 3.8 $' =~ /Revision: ([\d\.]+)/);
  403. X$version = "Prospero Beta.4.2 (Perl Archie Client Version $Revision)\n";
  404. X
  405. X# Should have at least one query.
  406. Xif ($#ARGV < 0) {
  407. X    if (defined($opt_version)) {
  408. X        print $version;
  409. X        exit(0);
  410. X    }
  411. X    print "Please specify at least one query.\n";
  412. X    print $usage;
  413. X    exit(255);
  414. X}
  415. X@string = @ARGV;
  416. X
  417. X%domainorder = ('ca', 1, 'edu', 2, 'com', 3, 'gov', 4, 'net', 5,
  418. X        'de', 6, 'dk', 7, 'nl', 8, 'fi', 9, 'se', 10,
  419. X        'au', 1000, 'nz', 1001);
  420. X
  421. X# For the conversion of date in the subroutine date.
  422. X%month = ('Jan', 1, 'Feb', 2, 'Mar', 3, 'Apr', 4, 'May', 5, 'Jun', 6, 
  423. X      'Jul', 7, 'Aug', 8, 'Sep', 9, 'Oct', 10, 'Nov', 11, 'Dec', 12);
  424. X@month = ('', 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 
  425. X      'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
  426. X
  427. X# The archie port number is 1525.
  428. X$port = 1525;
  429. X
  430. X# The socketaddr structure. See /usr/include/sys/socket.h for the C 
  431. X# version.
  432. X$sockaddr = 'S n a4 x8';
  433. X
  434. X# Defaults: maximum hit is 40. It does not mean there will be exactly
  435. X# 40 entries returned, though. Expect a few entries more or less.
  436. X# The default search option is case insensitive.
  437. X$match = 40; $case = 'S'; $pnum = 1;
  438. X
  439. X# The default format string. Can be overiden by the -format or -ffile 
  440. X# options. Can also specify a default format string in ~/.archierc
  441. X$format = "%02seq Host %host
  442. X
  443. X    Location: %dir
  444. X      %10type %mode %08size %date %name
  445. X
  446. X";
  447. X
  448. X# To get the user name and user home path.
  449. X@pw = getpwuid($<);
  450. X$user = $pw[0];
  451. X$userpath = $pw[7];
  452. X
  453. X# Read the system startup file if there is one. Set the filename in
  454. X# archie.depend.
  455. X
  456. X&parserc($startup);
  457. X
  458. X$startfile = defined($opt_rc) ? $opt_rc : "$userpath/.archierc";
  459. X$along = defined($opt_along);
  460. X&parserc($startfile) unless (defined($opt_norc));  # Read ~/.archierc?
  461. X$match = $opt_match if (defined($opt_match)); # how many hits wanted?
  462. Xprint $version      if (defined($opt_version)); # Print version number?
  463. X&pdomain($opt_domain) if (defined($opt_domain)); # Get a domain order?
  464. X
  465. X# The sort option. Default is by the domains of the hosts.
  466. X$sortpack = 'host';
  467. Xif ($opt_sort) {
  468. X    if ($opt_sort eq 'date') {
  469. X    $sortpack = 'date';
  470. X    }
  471. X    elsif ($opt_sort eq 'host') {
  472. X    $sortpack = 'host';
  473. X    }
  474. X    else {
  475. X    print "Not valid sort field: $opt_sort. Assume host.\n";
  476. X    $sortpack = 'host';
  477. X    }
  478. X}
  479. X$reversesort = defined($opt_reverse);
  480. X
  481. X# Read a format string from a file.
  482. Xif (defined($opt_ffile)) {
  483. X    open(FFILE, "$opt_ffile") || die "Can't open format file $opt_ffile\n";
  484. X    # slurp in the whole file
  485. X    undef $/; $format = <FFILE>; $/ = "\n";
  486. X    close FFILE;
  487. X}
  488. X
  489. X# Read a format string on the command line.
  490. X$format = $opt_format if (defined($opt_format));
  491. X
  492. X# Set the search option.
  493. X$case = $ecase = '=' if (defined($opt_exact));  # Exact match
  494. X$case = 'C' if (defined($opt_case));   # Set search option to case sensitive.
  495. X$case = 'S' if (defined($opt_nocase)); # Set search option to case insensitive.
  496. X$case = 'R' if (defined($opt_reg));    # search using a regular expression.
  497. X$case =~ tr/A-Z/a-z/ if ($ecase eq '=');
  498. X
  499. X# set a new archie server.
  500. Xif (defined($opt_server)) {
  501. X    $serverip = $servername = $opt_server;
  502. X    $servername =~ tr/A-Z/a-z/;
  503. X}
  504. X
  505. X# Support for a aftp pipe. [Useful only for the program nftp.]
  506. X$format = "%type:%host:%dir\n" if ($opt_aftp);
  507. X
  508. X# parse the format string,
  509. X$format = &parseformat($format);
  510. X
  511. X# This is for checking the format etc. Not for external use :-)
  512. Xif ($opt_syntax) {
  513. X    print "Execution until here.\n";
  514. X    exit(0);
  515. X}
  516. X
  517. X# Get the IP address of the archie server.
  518. Xif ($serverip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
  519. X  $thataddr = pack("CCCC", $1, $2, $3, $4);
  520. X  $serverip = $servername;
  521. X}
  522. Xelsif (!(($name, $aliases, $type, $len, $thataddr) = 
  523. X     gethostbyname($servername))) {
  524. X    $thataddr = &resolver($servername, $nsserver) || 
  525. X    die "Can't find the IP address of the archie server $servername\n";
  526. X    $serverip = join('.', unpack("CCCC", $thataddr));
  527. X}
  528. Xelse {
  529. X    $serverip = join('.', unpack("CCCC", $thataddr));
  530. X}
  531. X
  532. X$them = pack($sockaddr, &AF_INET, $port, $thataddr);
  533. X
  534. X# now construct our own address
  535. X# dnb@meshugge.media.mit.edu gave the patch to satisfy taintperl. 
  536. X$PATH = $ENV{'PATH'};
  537. X$ENV{'PATH'} = '/bin:/usr/bin';
  538. Xchop($thishost = `hostname`);
  539. X$ENV{'PATH'} = $PATH;
  540. X($name, $aliases, $type, $len, $thisaddr) = gethostbyname($thishost);
  541. X$us = pack($sockaddr, &AF_INET, 0, $thisaddr);
  542. X
  543. X# get and bind a socket.
  544. Xsocket(DATA, &AF_INET, &SOCK_DGRAM, 0) || die "socket:$!\n";
  545. Xbind(DATA, $us) || die "bind: $!\n";
  546. X
  547. X# Get the list of matches.
  548. X@lists = &list($them, $user, $match, @string);
  549. X
  550. X# Print them.
  551. X&result(@lists) unless ($along);
  552. X
  553. Xclose(DATA);
  554. X
  555. Xsub getpacket {
  556. X    local($restime) = @_;
  557. X    local($seq, $rin, $timeleft, $rout, $ans, $id, $hbyte, $rdp, $hdr_len);
  558. X    local($header, $backoff, $kk, $dum, $flags, $wantack, $pktsnum, $nfound);
  559. X    $seq = 0;
  560. X
  561. X    # wait for a packet to come back.
  562. X    $rin = '';
  563. X    vec($rin, fileno(DATA), 1) = 1;
  564. X    ($nfound, $timeleft) = select($rout = $rin, '', '', $restime);
  565. X    if ($timeleft == 0 || ord($rout) == 0){
  566. X    return(0);
  567. X    }
  568. X
  569. X    # Read a packet from the server.
  570. X    $ans = '';
  571. X    recv(DATA, $ans, 10000, 0) || die "recv: Can't recv. Die.\n";
  572. X
  573. X    $hbyte = ord(substr($ans, 0, 1));
  574. X    $header = '';
  575. X    if ($hbyte < 20) {
  576. X    $rdp = ($hbyte & 0xc0) >> 6;
  577. X    $hdr_len = $hbyte & 0x3F;
  578. X    $header = substr($ans, 0, $hdr_len);
  579. X    substr($ans, 0, $hdr_len) = '';
  580. X    $backoff = $seq = $kk = $flags = 0;
  581. X    ($dum, $id, $seq, $kk, $dum, $backoff, $flags) =
  582. X        unpack("Cnnnnnn", $header);
  583. X    # Should I acknowledge?
  584. X    $wantack = (($flags & 0x8000) != 0);
  585. X    $pktsnum = ($kk) ? $kk : 0;
  586. X    $timeout = $backoff if ($backoff);
  587. X    }
  588. X    else {
  589. X    $seq = 1;
  590. X    $pktsnum = 1;
  591. X    $wantack = 0;
  592. X    $timeout = 0;
  593. X    }
  594. X    return (1, $seq, $wantack, $pktsnum, $timeout, $ans);
  595. X}
  596. X
  597. X# The subroutine list is the `meat' of the query.
  598. X# It sends the query to the archie server host and parses the entries
  599. X# returned by the server.
  600. Xsub list {
  601. X    local($them, $user, $match, @words) = @_;
  602. X    local($ans, $timeout, $retries, $lines, @lines);
  603. X    local($pktsnum, $pktseq, $seq, $timeleft, $acktime);
  604. X    local($dum, $backoff, $word, $index, @received, $recthrough);
  605. X    local($sq, $waxk, $pkts, $tout);
  606. X    
  607. X    $timeout = 4;
  608. X    $retries = 3;
  609. X    $acktime = 0.3;
  610. X    @received = ('YES');
  611. X
  612. X    # Construct the query packet.
  613. X    @lines = ("VERSION 1\n", "AUTHENTICATOR UNAUTHENTICATED $user\n");
  614. X    foreach $word (@words) {
  615. X    push(@lines, "DIRECTORY ASCII ARCHIE/MATCH($match,0,$case)/$word\n");
  616. X    push(@lines, "LIST ATTRIBUTES COMPONENTS \n");
  617. X    }
  618. X    $lines = join('', @lines);
  619. X
  620. X    $recthrough = 0;
  621. X
  622. X  RETRY: 
  623. X    {
  624. X    $head = pack("Cnnnn", 9, $$, 1, 1, $recthrough);
  625. X    send(DATA, $head . $lines, 0, $them)
  626. X        || die "send: Failed to send packet: $!";
  627. X
  628. X    $pktsnum = 0;
  629. X    while ($pktsnum == 0 || $pktseq < $pktsnum) {
  630. X        $restime = $timeout;
  631. X        ($res, $sq, $wack, $pkts, $tout, $ans) = &getpacket($restime);
  632. X        if (!$res){
  633. X        if ($retries-- > 0) {
  634. X            $timeout *= 2;
  635. X            redo RETRY;
  636. X        }
  637. X        else {
  638. X            die "No responses from the archie server.\n";
  639. X        }
  640. X        }
  641. X        do {
  642. X        $seq = $sq;
  643. X        $timeout = $tout if ($tout);
  644. X        $pktsnum = $pkts if ($pkts);
  645. X        $wantack++ if ($wack);
  646. X        if ($seq) {
  647. X            if ($received[$seq] ne 'YES') {
  648. X            # not duplicate packet.
  649. X            $retries = 3;
  650. X            foreach $i (($#received + 1) .. ($seq - 1)) {
  651. X                $received[$i] = "NO $i";
  652. X            }
  653. X            $received[$seq] = 'YES';
  654. X            $ans =~ s/\000//g;
  655. X            $answer[$seq] = $ans unless ($recthrough >= $seq);
  656. X            @notyet = grep(/^NO/, @received);
  657. X            if ($#notyet < 0) {
  658. X                $recthrough = $#received;
  659. X                $pktseq = $#received;
  660. X            }
  661. X            else {
  662. X                $notyet[0] =~ /NO (\d+)$/;
  663. X                $recthrough = $1 - 1;
  664. X                $pktseq = $1 - 1;
  665. X            }
  666. X            if ($along) {
  667. X                &alongtheway($recthrough, 0);
  668. X            }
  669. X            }
  670. X            if ($pktsnum == 0 || $pktseq < $pktsnum) {
  671. X            ($res, $sq, $wack, $pkts, $tout, $ans) = 
  672. X                &getpacket($acktime);
  673. X            }
  674. X            else {
  675. X                    $head = pack("Cnnnn", 9, $$, 1, 1, $recthrough);
  676. X            last;
  677. X            }
  678. X        }
  679. X        } until (!$res || $seq == 0);
  680. X        $head = pack("Cnnnn", 9, $$, 1, 1, $recthrough);
  681. X        if ($wantack) {
  682. X        send(DATA, $head . $lines, 0, $them)
  683. X            || die "send: Failed to send an acknowledgement: $!";
  684. X        $wantack = 0;
  685. X        }
  686. X    }
  687. X    }
  688. X    if ($wantack) {
  689. X    send(DATA, $head . $lines, 0, $them)
  690. X        || die "send: Failed to send an acknowledgement: $!";
  691. X    }
  692. X    if ($along) {
  693. X    &alongtheway($recthrough, 1);
  694. X    }
  695. X    @answer;
  696. X}
  697. X
  698. X# Print the entries in a packet.
  699. Xsub parselist {
  700. X    local(@lists) = @_;
  701. X    local(@lines, $dum, $lastmod, $modes, $size, $dir, $entry);
  702. X    local($name, @attr, @ainfo, $type);
  703. X
  704. X    $entry = 0;
  705. X    # split the lines in the packet first.
  706. X    @lines = split(/\n/, join('', @lists));
  707. X    foreach $line (@lines) {
  708. X    # If a LINK L line, then get the initial fields for the
  709. X    # entry. Output the last entry if there is one.
  710. X    if ($line =~ /^LINK L/) {
  711. X        &store($host, $type, $dir, $size, $modes, $lastmod, $name) 
  712. X        if ($entry);
  713. X        $type = $name = $host = $dir = '';
  714. X        $size = $modes = $lastmod = '';
  715. X        $#attr = $#ainfo = -1;
  716. X        ($dum, $dum, $type, $name, $dum, $host, $dum, $dir, $dum, $dum) =
  717. X        split(/ /, $line);
  718. X        $host =~ tr/A-Z/a-z/;
  719. X        $entry = 1;
  720. X    }
  721. X    elsif ($line =~ /^LINK /) {
  722. X        # What should I do if the response is LINK but not L?
  723. X    }
  724. X    elsif ($line =~ /^LINK-INFO/) {
  725. X        # A LINK-INFO line. Get one attribute per line.
  726. X        ($dum, $dum, $attr, $dum, @info) = split(/ /, $line);
  727. X        if ($attr eq 'SIZE') {
  728. X        $size = join(' ', @info);
  729. X        }
  730. X        elsif ($attr eq 'UNIX-MODES') {
  731. X        $modes = join(' ', @info);
  732. X        }
  733. X        elsif ($attr eq 'LAST-MODIFIED') {
  734. X        $lastmod = join(' ', @info);
  735. X        }
  736. X        else {
  737. X        push(@attr, $attr);
  738. X        push(@ainfo, join(' ', @info));
  739. X        }
  740. X    }
  741. X    elsif ($line =~ /^VERSION-NOT-SUPPORTED TRY (\d+)-(\d+),(\d+)/) {
  742. X        die "Version of archie server ($1-$2, $3) not supported.\n";
  743. X    }
  744. X    elsif ($line =~ /^NOT-A-DIRECTORY/) {
  745. X        print "Archie error: Not a directory.\n";
  746. X    }
  747. X    elsif ($line =~ /^UNRESOLVED/) {
  748. X        print "Archie error: Unresolved entries.\n";
  749. X    }
  750. X    elsif ($line =~ /^FILTER/) {
  751. X    }
  752. X    elsif ($line =~ /^OBJECT-INFO/) {
  753. X    }
  754. X    elsif ($line =~ /^NONE-FOUND/) {
  755. X    }
  756. X    elsif ($line =~ /^SUCCESS/) {
  757. X    }
  758. X    elsif ($line =~ /^FORWARDED/) {
  759. X        print "Archie error: No forwarding allowed.\n";
  760. X    }
  761. X    elsif ($line =~ /^FAILURE/) {
  762. X        print "Archie server returns error. \n";
  763. X        if ($line =~ /^FAILURE NOT-AUTHORIZED/) {
  764. X        print "Probably Max. hit too high. Use smaller -match value\n";
  765. X        }
  766. X        else {
  767. X        print "The error message is:\n";
  768. X        print $line;
  769. X        }
  770. X    }
  771. X    elsif ($line =~ /^NOT-AUTHORIZED/) {
  772. X        print "Archie error: Not authorized.\n";
  773. X    }
  774. X    else {
  775. X    }
  776. X    }
  777. X    &store($host, $type, $dir, $size, $modes, $lastmod, $name) if ($entry);
  778. X}
  779. X
  780. X# Write the fields out on terminal using the format string.
  781. Xsub write {
  782. X    local($host, $type, $dir, $size, $mode, $lastmod, $name) = @_;
  783. X    local($seq, @path, $date, $path);
  784. X
  785. X    # Convert the date string from 19910713123250Z to
  786. X    # 1991 Jul 13 12:32:50 GMT
  787. X    $date = ($lastmod eq '') ? 'No Date' : &date($lastmod);
  788. X    $seq = $pnum++;
  789. X
  790. X    # print the entry. Die if something is wrong. Should I
  791. X    # Log the output in a file so the effect is not wasted?
  792. X    eval "printf $format"
  793. X    || die "A syntax error occured when printing the format string: $@\n";
  794. X}
  795. X
  796. X# Convert a string.
  797. Xsub date {
  798. X    local($date) = @_;
  799. X    local($year, $month, $day, $hour, $min, $sec) =
  800. X    (0, 1, 0, 0, 0, 0);
  801. X    local($zone) = 'Z';
  802. X
  803. X    ($year, $month, $day, $hour, $min, $sec, $zone) = 
  804. X    ($date =~ /^(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(.*)/);
  805. X
  806. X    # A time zone Z is the same as GMT.
  807. X    if ($zone eq 'Z') {
  808. X    $zone = 'GMT';
  809. X    }
  810. X    "$year $month[$month] $day $hour:$min:$sec $zone";
  811. X}
  812. X
  813. X# Parse the format string to convert it to a valid perl format
  814. X# string.
  815. Xsub parseformat {
  816. X    local($string) = @_;
  817. X    local($nstring, $index, @plist);
  818. X
  819. X    $string =~ s/([\$\{\}\@\*])/\\$1/g;
  820. X    $nstring = '';
  821. X    $#plist = -1;
  822. X    while (($index = index($string, '%')) >= 0) {
  823. X    $nstring .= substr($string, 0, $index);
  824. X    substr($string, 0, $index) = '';
  825. X    if (substr($string, 1, 1) eq '%') {
  826. X        substr($string, 0, 2) = '';
  827. X        $nstring .= '%%';
  828. X    }
  829. X    elsif ($string =~ /^\%(\d*)(host|dir|mode|date|seq|size|name|type)/) {
  830. X        push(@plist, "\$$2");
  831. X        if ($2 eq 'size' || $2 eq 'seq') {
  832. X        $nstring .= "\%$1d";
  833. X        }
  834. X        else {
  835. X        $nstring .= "\%$1s";
  836. X        }
  837. X        substr($string, 0, length($1 . $2) + 1) = '';
  838. X    }
  839. X    else {
  840. X        die sprintf("$prog: Format error. Unknown field: %s\n", $string);
  841. X    }
  842. X    }
  843. X    $nstring .= $string;
  844. X    $nstring = '"' . $nstring . '"';
  845. X    join(', ', $nstring, @plist);
  846. X}
  847. X
  848. X# Parse the startup file ~/.archierc
  849. X# The format of the file is very simple:
  850. X# command option
  851. X# The format command must be the last one.
  852. Xsub parserc {
  853. X    local($startfile) = @_;
  854. X    local($domain, @domain);
  855. X    if (-e $startfile && -r $startfile) {
  856. X    open (RC, $startfile) || return;
  857. X    while (<RC>) {
  858. X        chop;
  859. X        if (/^\s*match\s+(\d+)\s*$/) {
  860. X        $match = $1;
  861. X        }
  862. X        elsif (/^\s*sort\s+/) {
  863. X        if (/^\s*sort\s+date\s*$/) {
  864. X            $sortpack = 'date';
  865. X        }
  866. X        elsif (/^\s*sort\s+host\s*$/) {
  867. X            $sortpack = 'host';
  868. X        }
  869. X        else {
  870. X            print "Unknown sort field in startup file: $startfile\n";
  871. X        }
  872. X        }
  873. X        elsif (/^\s*domain\s+(.*)$/) {
  874. X        &pdomain($1);
  875. X        }
  876. X        elsif (/^\s*search\s+([a-z]+)\s*$/) {
  877. X        if ($1 eq 'case') {
  878. X            $case = 'C';
  879. X        }
  880. X        elsif ($1 eq 'nocase') {
  881. X            $case = 'S';
  882. X        }
  883. X        elsif ($1 eq 'reg') {
  884. X            $case = 'R';
  885. X        }
  886. X        elsif ($1 eq 'exact') {
  887. X            $case = '=';
  888. X        }
  889. X        else {
  890. X            print "$prog: $user/.archierc: unknown search option $1\n";
  891. X        }
  892. X        }
  893. X        elsif (/^\s*host\s+(.+)\s*$/) {
  894. X        $archieserver = $1;
  895. X        }
  896. X        elsif (/^\s*format\s*$/) {
  897. X        undef $/; $format = <RC>; $/ = "\n";
  898. X        last;
  899. X        }
  900. X        elsif ($_ =~ /^\s*$/ || $_ =~ /^\s*\#/) {
  901. X        # Empty or comment line in the startup file.
  902. X        }
  903. X        else {
  904. X        print "$prog: Unknown option in $user/.archierc: $_\n";
  905. X        }
  906. X    }
  907. X    close(RC);
  908. X    }
  909. X}
  910. X
  911. Xsub store {
  912. X    local($host, $type, $dir, $size, $mode, $lastmod, $name) = @_;
  913. X
  914. X    $type = ($type eq 'DIRECTORY') ? 'Directory' : 'File';
  915. X    if ($type eq 'Directory' && $dir =~ m.ARCHIE/HOST.) {
  916. X    ($archie, $dum, $host, $dir) = 
  917. X        ($dir =~ m|([^/]+)/([^/]+)/([^/]+)/(.*)$|);
  918. X    $dir = '/' . $dir;
  919. X    }
  920. X    push(@s_lastmod, $lastmod);
  921. X    push(@s_name, $name);
  922. X    push(@s_host, $host);
  923. X    push(@s_type, $type);
  924. X    push(@s_dir, $dir);
  925. X    push(@s_size, $size);
  926. X    push(@s_mode, $mode);
  927. X}
  928. X
  929. Xsub result {
  930. X    local(@lists) = @_;
  931. X    local(%entries, $host, $index, @order, @host, $order, $field);
  932. X    $#s_lastmod = -1;
  933. X    $#s_name = -1;
  934. X    $#s_host = -1;
  935. X    $#s_type = -1;
  936. X    $#s_dir = -1;
  937. X    $#s_mode = -1;
  938. X    $#s_size = -1;
  939. X    &parselist(@lists);
  940. X    $index = 0;
  941. X    %entries = ();
  942. X    @field =  ($sortpack eq 'date') ? @s_lastmod : @s_host;
  943. X    foreach $field (@field) {
  944. X    $entries{$field} .= "$index ";
  945. X    $index++;
  946. X    }
  947. X    @order = ($sortpack eq 'date') ? sort sortdate @s_lastmod : 
  948. X    sort sorthost @s_host;
  949. X    foreach $order (@order) {
  950. X    if ($entries{$order} ne '') {
  951. X        @indexes = split(' ', $entries{$order});
  952. X        foreach $i (@indexes) {
  953. X        &write($s_host[$i], $s_type[$i], $s_dir[$i],
  954. X               $s_size[$i], $s_mode[$i], $s_lastmod[$i], $s_name[$i]);
  955. X        }
  956. X        $entries{$order} = '';
  957. X    }
  958. X    }
  959. X}
  960. X
  961. Xsub sorthost {
  962. X    local($t);
  963. X    local($c, $d);
  964. X    @c = split(/\./, $a);
  965. X    @d = split(/\./, $b);
  966. X    $domainorder{$c[$#c]} = 1100 if ($domainorder{$c[$#c]} eq '');
  967. X    $domainorder{$d[$#d]} = 1100 if ($domainorder{$d[$#d]} eq '');
  968. X    $t = ($domainorder{$c[$#c]} > $domainorder{$d[$#d]}) ? 1 :
  969. X    ($domainorder{$c[$#c]} < $domainorder{$d[$#d]}) ? -1 : 0;
  970. X    ($reversesort) ? -$t : $t;
  971. X}
  972. X
  973. Xsub sortdate {
  974. X    local($t);
  975. X    local(@c, @d, $c, $d, $e, $f);
  976. X    $c = $a; $d = $b;
  977. X    @c = split(/ /, $c);
  978. X    @d = split(/ /, $d);
  979. X    $e = join(' ', $c[0], "$month{$c[1]}", @c[2 .. 6]);
  980. X    $f = join(' ', $d[0], "$month{$d[1]}", @d[2 .. 6]);
  981. X    $t = $e gt $f ? 1 : $e lt $f ? -1 : 0;
  982. X    ($reversesort) ? -$t : $t;
  983. X}
  984. X
  985. Xsub pdomain {
  986. X    local($list) = @_;
  987. X    local($domain, @domain, $index);
  988. X    @domain = split(/ /, $list);
  989. X    $index = 0;
  990. X    foreach $domain (@domain) {
  991. X    $domainorder{$domain} = $index;
  992. X    $index++;
  993. X    }
  994. X}    
  995. X
  996. Xsub alongtheway {
  997. X    local($through, $all) = @_;
  998. X    return if ($queuehead > $through);
  999. X    local(@link, @part, @part1);
  1000. X    @part = split(/\n/, join('', @answer[$queuehead .. $through]));
  1001. X    if (!$all) {
  1002. X    while(($line = pop(@part)) !~ /^LINK L/) {
  1003. X        unshift(@part1, $line);
  1004. X    }
  1005. X    unshift(@part1, $line) unless ($line eq '');
  1006. X    $answer[$through] = join("\n", @part1);
  1007. X    $answer[$through] .= "\n";
  1008. X    $queuehead = $through;
  1009. X    }
  1010. X    &result(join("\n", @part));
  1011. X}
  1012. END_OF_FILE
  1013. if test 18760 -ne `wc -c <'archie'`; then
  1014.     echo shar: \"'archie'\" unpacked with wrong size!
  1015. fi
  1016. chmod +x 'archie'
  1017. # end of 'archie'
  1018. fi
  1019. if test -f 'archie.l' -a "${1}" != "-c" ; then 
  1020.   echo shar: Will not clobber existing file \"'archie.l'\"
  1021. else
  1022. echo shar: Extracting \"'archie.l'\" \(7023 characters\)
  1023. sed "s/^X//" >'archie.l' <<'END_OF_FILE'
  1024. X.\" $Id: archie.l,v 3.6 1991/08/03 00:16:30 clipper Exp clipper $
  1025. X.TH ARCHIE L "28 JULY 1991"
  1026. X
  1027. X.SH NAME
  1028. Xarchie \- query an archie server
  1029. X
  1030. X.SH SYNOPSIS
  1031. X.B archie
  1032. X.RB [ " \-match hits " ]
  1033. X.RB [ " \-reg " ]
  1034. X.RB [ " \-exact " ]
  1035. X.RB [ " \-nocase " ]
  1036. X.RB [ " \-case " ]
  1037. X.RB [ " \-server hostname " ]
  1038. X.RB [ " \-ffile formatfile " ]
  1039. X.RB [ " \-format format " ]
  1040. X.RB [ " \-norc " ]
  1041. X.RB [ " \-rc" ]
  1042. X.RB [ " \-sort date \| host " ]
  1043. X.RB [ " \-reverse " ]
  1044. X.RB [ " \-version " ]
  1045. X.RB [ " \-domain string " ]
  1046. X.RB [ " \-along " ]
  1047. X.IR word1 
  1048. X.IR word2 \&.\|.\|.
  1049. X.LP
  1050. X
  1051. X.SH DESCRIPTION
  1052. X.B archie
  1053. Xarchie queries a remote database to identify files and directories
  1054. Xwith the words 'world1', 'word2', etc, in their names.  The program
  1055. Xallows the user to specify a format to print the matching entries.
  1056. X.LP
  1057. Xarchie is a database that assists users in identify the sites that
  1058. Xhave files matching the given words.  For example, if you want to find
  1059. Xout the anonymous sites carrying the file 'wonder', a query to the
  1060. Xarchie database will return a list of the hosts with files whose names
  1061. Xinclude that string.  The directory and file name are also returned so
  1062. Xthat the user can subsequently retrieve the file.
  1063. X
  1064. X.LP
  1065. X.SH NOTE
  1066. X
  1067. XPlease set the maximum hit number to a moderate number. The archie
  1068. Xserver you are accessing is used by many people. Setting the maximum
  1069. Xhit number to a very high number in peak periods not only lengthen the
  1070. Xtime you have to wait for the response, it also lengthens the time
  1071. Xother people have to wait too. Please also refrain from having a large
  1072. Xnumber of queries in peak periods for the same reason.
  1073. X
  1074. X.LP
  1075. X.SH OPTIONS
  1076. X
  1077. XYou must have all the options listed before the words you want to
  1078. Xmatch. Otherwise, the options after the first word will be treated as
  1079. Xadditional words. For example, `archie word -reg' queries two words,
  1080. X`word' and `-reg'.
  1081. X
  1082. X.TP
  1083. X.B \-match hits
  1084. XSet the maximum number of hits to be ` hits '. The default number is
  1085. X40. Please set this to a moderate number.
  1086. X.TP
  1087. X.B \-case
  1088. XSet the search option to be case sensitive.
  1089. X.TP
  1090. X.B \-nocase
  1091. XSet the search option to be case insensitive.
  1092. X.TP
  1093. X.B \-exact
  1094. XSet the search option to be exact.
  1095. X.TP
  1096. X.B \-reg
  1097. XSet the search option to be regular expression.
  1098. X.TP
  1099. X.B \-along
  1100. XPrints the entries along the way. The default is to print the entries
  1101. Xafter all of them have been obtained. If the connection dies in the
  1102. Xmiddle of the query, you will have the partial list up to that time.
  1103. X.TP
  1104. X.B \-server hostname 
  1105. XSet the archie server to ` hostname '.
  1106. X.TP
  1107. X.B \-ffile filename
  1108. XRead the file ` filename ' to get the format string.
  1109. X.TP
  1110. X.B \-format string
  1111. XSet the format string to be ` string '. For example, \-format '%host:%dir:%size:%date\\n'.
  1112. XNotice the single quotes will prevent the shell from interpreting the string.
  1113. X.TP
  1114. X.B \-norc
  1115. XDo not read the .archierc file from the user's home directory.
  1116. X.TP
  1117. X.B \-rc filename
  1118. XUse filename as the startup file instead.
  1119. X.TP
  1120. X.B \-sort [host | date]
  1121. XSort by the host or date. To sort by host, the sort key is the domain
  1122. Xof the hosts. This is useful for sorting the entries by the distance
  1123. Xof the hosts to your own machine.
  1124. X.TP
  1125. X.B \-reverse
  1126. XTo reverse the sorting order.
  1127. X.TP
  1128. X.B \-version
  1129. XTo print out the version number of the program.
  1130. X.TP
  1131. X.B \-domain string
  1132. XIf the sorting is done using the hosts, use the order specify by
  1133. X`string' to order the hosts. For example, if `string' is 'nl de fi fr
  1134. Xedu ca', then the hosts in nl domain will be first; the hosts in the
  1135. Xde domain will be printed second, etc.
  1136. X
  1137. X.LP
  1138. X.SH STARTUP FILE
  1139. X.I Archie
  1140. Xreads the file ` .archierc ' from the user's home directory. The
  1141. Xcommands allowed are ` match ', ` search ', ` host ', ` domain ' and `
  1142. Xformat '.  The format command must be specified last in the file.
  1143. XEach line has two fields; the first field is the name of the command
  1144. Xand the second field is the option value. The value of the ` match '
  1145. Xoption is an integer. The values allowed for the ` search ' command
  1146. Xare
  1147. X.I case, nocase, reg, exact
  1148. Xwith the same meaning as on the command line. The ` host ' command
  1149. Xallows an alternate archie server to be specified. The file can have
  1150. Xcomment lines before the format option. Each comment line must appear
  1151. Xon a separate line.  The `domain' field is used to specify the order
  1152. Xof hosts to be printed. This is useful to specify the nearest hosts
  1153. Xfirst and farthest hosts at the end. No comments are allowed on the
  1154. Xsame lines as the commands. A comment line is started with the \#
  1155. Xcharacter.
  1156. X
  1157. X.LP
  1158. X.SH OUTPUT FORMAT
  1159. XThe output of
  1160. X.I archie
  1161. Xis controled by a format string. This format string can be changed in
  1162. Xthe archie startup file, specified on the command line, or read from a
  1163. Xfile. The format string has a similar syntax with the format file of
  1164. Xprintf(). The escape character for fields is %. The meaning of
  1165. Xbackslash is similar to that in printf. The allowed fields are:
  1166. X
  1167. X.PD 0
  1168. X.TP 10
  1169. X.B %
  1170. XDouble % will produce a single % in the output.
  1171. X.TP
  1172. X.B host
  1173. XThis field will be replaced by the host name in an entry.
  1174. X.TP
  1175. X.B dir
  1176. XThis field specifies the path of the entry.
  1177. X.TP
  1178. X.B mode
  1179. XThe protection of the entry.
  1180. X.TP
  1181. X.B date
  1182. XThe date of last modification of the entry.
  1183. X.TP
  1184. X.B seq
  1185. XThe number of entries processed so far.
  1186. X.TP
  1187. X.B size
  1188. XThe size of the entry.
  1189. X.TP
  1190. X.B name
  1191. XThe filename of entry.
  1192. X.TP
  1193. X.B type
  1194. XThe file type of the entry, a directory or a file.
  1195. X
  1196. X.LP
  1197. XAfter the % character and before the field string, a optional number
  1198. Xis allowed to specify the width of the field possibly zero-padded. For
  1199. Xexample, '%04seq' means zero-padded 4-character width field for the
  1200. Xsequence number.
  1201. X
  1202. X.LP
  1203. X.SH SEE ALSO
  1204. X.BR telnet(1)
  1205. X.BR ftp (1)
  1206. X
  1207. X.LP
  1208. X.SH BUGS
  1209. X.LP
  1210. XThis program is under revision. Probably has quite a few bugs.
  1211. X
  1212. X.LP
  1213. X.SH DIAGNOSTICS
  1214. X.TP
  1215. X.BI "archie: Format string ignored: a format file was specified"
  1216. XA format string was specified after a format file was given.
  1217. X.TP
  1218. X.BI "archie: Format error. Unknown field: " string
  1219. X.I String
  1220. Xis not recognized.
  1221. X.TP
  1222. X.BI "archie: " user "/.archierc: unknown search option " option
  1223. XThe match option 
  1224. X.I option
  1225. Xin
  1226. X.I user
  1227. X/.archierc is not known.
  1228. X.TP
  1229. X.BI "archie: Unknown option in " user "/.archierc: " option
  1230. XThe option in
  1231. X.I user
  1232. Xarchie startup file is not known.
  1233. X
  1234. X.LP
  1235. X.SH AUTHOR
  1236. XKhun Yee Fung (clipper@csd.uwo.ca). Department of Computer Science,
  1237. XUniversity of Western Ontario.
  1238. X
  1239. X.LP
  1240. X.SH AUTHOR OF PROSPERO
  1241. XThe Archie client queries a remote database using the Prospero
  1242. Xprotocol.  Clifford Neuman (bcn@isi.edu) designed the Prospero
  1243. Xprotocol and wrote the server.
  1244. X
  1245. X
  1246. X.LP
  1247. X.SH THE ARCHIE GROUP
  1248. XThe Prospero server queries the Archie database and returns the
  1249. Xresults.  It is the Archie database that is responding to your query.
  1250. XThe archie database is written and maintained by Allan Emtage
  1251. X(bajan\@cs.mcgill.ca) and Bill Heelan (wheelan\@cs.mcgill.ca).  Peter
  1252. XDeutsch (peterd\@cs.mcgill.ca) is also involved in the archie group in
  1253. XMcGill.
  1254. X
  1255. X.LP
  1256. X.SH COPYRIGHT
  1257. XYou can modify, distribute, and generally do anything you want to this
  1258. Xfile except to sell it for profit. You must preserve the copyright
  1259. Xnotice in all copies of this program.
  1260. X
  1261. XABSOLUTELY NO WARRANTY.
  1262. END_OF_FILE
  1263. if test 7023 -ne `wc -c <'archie.l'`; then
  1264.     echo shar: \"'archie.l'\" unpacked with wrong size!
  1265. fi
  1266. # end of 'archie.l'
  1267. fi
  1268. if test -f 'socket.ph' -a "${1}" != "-c" ; then 
  1269.   echo shar: Will not clobber existing file \"'socket.ph'\"
  1270. else
  1271. echo shar: Extracting \"'socket.ph'\" \(2752 characters\)
  1272. sed "s/^X//" >'socket.ph' <<'END_OF_FILE'
  1273. Xif (!defined &_sys_socket_h) {
  1274. X    eval 'sub _sys_socket_h {1;}';
  1275. X    eval 'sub SOCK_STREAM {1;}';
  1276. X    eval 'sub SOCK_DGRAM {2;}';
  1277. X    eval 'sub SOCK_RAW {3;}';
  1278. X    eval 'sub SOCK_RDM {4;}';
  1279. X    eval 'sub SOCK_SEQPACKET {5;}';
  1280. X    eval 'sub SO_DEBUG {0x0001;}';
  1281. X    eval 'sub SO_ACCEPTCONN {0x0002;}';
  1282. X    eval 'sub SO_REUSEADDR {0x0004;}';
  1283. X    eval 'sub SO_KEEPALIVE {0x0008;}';
  1284. X    eval 'sub SO_DONTROUTE {0x0010;}';
  1285. X    eval 'sub SO_BROADCAST {0x0020;}';
  1286. X    eval 'sub SO_USELOOPBACK {0x0040;}';
  1287. X    eval 'sub SO_LINGER {0x0080;}';
  1288. X    eval 'sub SO_OOBINLINE {0x0100;}';
  1289. X    eval 'sub SO_DONTLINGER {(~ &SO_LINGER);}';
  1290. X    eval 'sub SO_SNDBUF {0x1001;}';
  1291. X    eval 'sub SO_RCVBUF {0x1002;}';
  1292. X    eval 'sub SO_SNDLOWAT {0x1003;}';
  1293. X    eval 'sub SO_RCVLOWAT {0x1004;}';
  1294. X    eval 'sub SO_SNDTIMEO {0x1005;}';
  1295. X    eval 'sub SO_RCVTIMEO {0x1006;}';
  1296. X    eval 'sub SO_ERROR {0x1007;}';
  1297. X    eval 'sub SO_TYPE {0x1008;}';
  1298. X    eval 'sub SOL_SOCKET {0xffff;}';
  1299. X    eval 'sub AF_UNSPEC {0;}';
  1300. X    eval 'sub AF_UNIX {1;}';
  1301. X    eval 'sub AF_INET {2;}';
  1302. X    eval 'sub AF_IMPLINK {3;}';
  1303. X    eval 'sub AF_PUP {4;}';
  1304. X    eval 'sub AF_CHAOS {5;}';
  1305. X    eval 'sub AF_NS {6;}';
  1306. X    eval 'sub AF_NBS {7;}';
  1307. X    eval 'sub AF_ECMA {8;}';
  1308. X    eval 'sub AF_DATAKIT {9;}';
  1309. X    eval 'sub AF_CCITT {10;}';
  1310. X    eval 'sub AF_SNA {11;}';
  1311. X    eval 'sub AF_DECnet {12;}';
  1312. X    eval 'sub AF_DLI {13;}';
  1313. X    eval 'sub AF_LAT {14;}';
  1314. X    eval 'sub AF_HYLINK {15;}';
  1315. X    eval 'sub AF_APPLETALK {16;}';
  1316. X    eval 'sub AF_NIT {17;}';
  1317. X    eval 'sub AF_802 {18;}';
  1318. X    eval 'sub AF_OSI {19;}';
  1319. X    eval 'sub AF_X25 {20;}';
  1320. X    eval 'sub AF_OSINET {21;}';
  1321. X    eval 'sub AF_GOSIP {22;}';
  1322. X    eval 'sub AF_MAX {21;}';
  1323. X    eval 'sub PF_UNSPEC { &AF_UNSPEC;}';
  1324. X    eval 'sub PF_UNIX { &AF_UNIX;}';
  1325. X    eval 'sub PF_INET { &AF_INET;}';
  1326. X    eval 'sub PF_IMPLINK { &AF_IMPLINK;}';
  1327. X    eval 'sub PF_PUP { &AF_PUP;}';
  1328. X    eval 'sub PF_CHAOS { &AF_CHAOS;}';
  1329. X    eval 'sub PF_NS { &AF_NS;}';
  1330. X    eval 'sub PF_NBS { &AF_NBS;}';
  1331. X    eval 'sub PF_ECMA { &AF_ECMA;}';
  1332. X    eval 'sub PF_DATAKIT { &AF_DATAKIT;}';
  1333. X    eval 'sub PF_CCITT { &AF_CCITT;}';
  1334. X    eval 'sub PF_SNA { &AF_SNA;}';
  1335. X    eval 'sub PF_DECnet { &AF_DECnet;}';
  1336. X    eval 'sub PF_DLI { &AF_DLI;}';
  1337. X    eval 'sub PF_LAT { &AF_LAT;}';
  1338. X    eval 'sub PF_HYLINK { &AF_HYLINK;}';
  1339. X    eval 'sub PF_APPLETALK { &AF_APPLETALK;}';
  1340. X    eval 'sub PF_NIT { &AF_NIT;}';
  1341. X    eval 'sub PF_802 { &AF_802;}';
  1342. X    eval 'sub PF_OSI { &AF_OSI;}';
  1343. X    eval 'sub PF_X25 { &AF_X25;}';
  1344. X    eval 'sub PF_OSINET { &AF_OSINET;}';
  1345. X    eval 'sub PF_GOSIP { &AF_GOSIP;}';
  1346. X    eval 'sub PF_MAX { &AF_MAX;}';
  1347. X    eval 'sub SOMAXCONN {5;}';
  1348. X    eval 'sub MSG_OOB {0x1;}';
  1349. X    eval 'sub MSG_PEEK {0x2;}';
  1350. X    eval 'sub MSG_DONTROUTE {0x4;}';
  1351. X    eval 'sub MSG_MAXIOVLEN {16;}';
  1352. X}
  1353. X1;
  1354. END_OF_FILE
  1355. if test 2752 -ne `wc -c <'socket.ph'`; then
  1356.     echo shar: \"'socket.ph'\" unpacked with wrong size!
  1357. fi
  1358. # end of 'socket.ph'
  1359. fi
  1360. if test -f 'resolver.pl' -a "${1}" != "-c" ; then 
  1361.   echo shar: Will not clobber existing file \"'resolver.pl'\"
  1362. else
  1363. echo shar: Extracting \"'resolver.pl'\" \(4269 characters\)
  1364. sed "s/^X//" >'resolver.pl' <<'END_OF_FILE'
  1365. X#!/usr2/new/bin/perl                                  #-*-perl-*-
  1366. X# a subroutine to resolve a Internet host name to IP address
  1367. X# Copyright (C) Khun Yee Fung (clipper@csd.uwo.ca) 1991
  1368. X# You can do anything to this file except to sell it and/or pretend
  1369. X# you wrote it. You must preserve the copyright notice.
  1370. Xpackage resolver;
  1371. X
  1372. Xsub main'resolver {
  1373. X  local($sockaddr) = 'S n a4 x8';
  1374. X  local($hostname, $server) = @_;
  1375. X  local($port) = 53;
  1376. X
  1377. X  if ($server =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/) {
  1378. X      $saddr = pack('CCCC', $1, $2, $3, $4);
  1379. X  }
  1380. X  elsif (!(($name, $aliases, $type, $len, $saddr) = gethostbyname($server))) {
  1381. X      return 0;
  1382. X  }
  1383. X  local($sin) = pack($sockaddr, 2, $port, $saddr);
  1384. X
  1385. X  socket(NSERVER, 2, 1, 0) || return 0;
  1386. X  connect(NSERVER, $sin) || return 0;
  1387. X
  1388. X  select(NSERVER); $| = 1; select(STDOUT); $| = 1;
  1389. X
  1390. X  local($len) = 18 + length($hostname);
  1391. X  local(@names) = split('\.', $hostname);
  1392. X  local($head) = pack('S6', 319, 256, 1, 0, 0, 0);
  1393. X  print NSERVER pack('S', $len), $head;
  1394. X  local($arg, $response);
  1395. X  foreach $arg (@names) {
  1396. X    print NSERVER pack('C', length($arg)), $arg;
  1397. X  }
  1398. X  print NSERVER pack('CS2', 0, 1, 1);
  1399. X
  1400. X  read(NSERVER, $len, 2);
  1401. X  read(NSERVER, $response, unpack('S', $len));
  1402. X  close NSERVER;
  1403. X
  1404. X  local(@shead) = unpack('S6', $response);
  1405. X  ($shead[1] & 0x0F) == 0 || return 0;
  1406. X
  1407. X  local($in) = 12;
  1408. X  local($ans) = $shead[2];
  1409. X  local($c);
  1410. X  while ($ans > 0) {
  1411. X    while (($c = ord(substr($response, $in++, 1))) != 0) {
  1412. X      $in += $c;
  1413. X    }
  1414. X    $in += 4;
  1415. X    $ans--;
  1416. X  }
  1417. X
  1418. X  $ans = $shead[3];
  1419. X  local($type, $rdlength, $rdata);
  1420. X  local(@return);
  1421. X  while ($ans > 0) {
  1422. X    while (($c = ord(substr($response, $in++, 1))) != 0) {
  1423. X      ($c & 0xc0) != 0xc0 || $in++, last;
  1424. X      $in += $c;
  1425. X    }
  1426. X    $type = substr($response, $in, 2);
  1427. X    $in += 8;
  1428. X    $rdlength = unpack('n', substr($response, $in, 2));
  1429. X    $in += 2;
  1430. X    $rdata = substr($response, $in, $rdlength);
  1431. X    if (unpack('S', $type) == 1) {
  1432. X    push(@return, $rdata);
  1433. X    }
  1434. X    $in += $rdlength;
  1435. X    $ans--;
  1436. X  }
  1437. X  return @return;
  1438. X}
  1439. X
  1440. Xsub main'rresolver {
  1441. X  local($sockaddr) = 'S n a4 x8';
  1442. X  local($hostname, $server) = @_;
  1443. X  local($port) = 53;
  1444. X
  1445. X  if ($server =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/) {
  1446. X      $saddr = pack('CCCC', $1, $2, $3, $4);
  1447. X  }
  1448. X  elsif (!(($name, $aliases, $type, $len, $saddr) = gethostbyname($server))) {
  1449. X      return 0;
  1450. X  }
  1451. X  local($sin) = pack($sockaddr, 2, $port, $saddr);
  1452. X
  1453. X  socket(NSERVER, 2, 1, 0) || return 0;
  1454. X  connect(NSERVER, $sin) || return 0;
  1455. X
  1456. X  select(NSERVER); $| = 1; select(STDOUT); $| = 1;
  1457. X
  1458. X  local($len) = 18 + length($hostname);
  1459. X  local(@names) = split('\.', $hostname);
  1460. X  local($head) = pack('S6', 319, 256, 1, 0, 0, 0);
  1461. X  print NSERVER pack('S', $len), $head;
  1462. X  @names = reverse(@names);
  1463. X  push(@names, "in-addr", "arpa");
  1464. X  foreach $arg (@names) {
  1465. X    print NSERVER pack('C', length($arg)), $arg;
  1466. X  }
  1467. X  print NSERVER pack('CS2', 0, 12, 1);
  1468. X
  1469. X  read(NSERVER, $len, 2);
  1470. X  read(NSERVER, $response, unpack('S', $len));
  1471. X  close NSERVER;
  1472. X
  1473. X  @shead = unpack('S6', $response);
  1474. X  ($shead[1] & 0x0F) == 0 || return 0;
  1475. X
  1476. X  $in = 12;
  1477. X  $ans = $shead[2];
  1478. X  while ($ans > 0) {
  1479. X    while (($c = ord(substr($response, $in++, 1))) != 0) {
  1480. X      $in += $c;
  1481. X    }
  1482. X    $in += 4;
  1483. X    $ans--;
  1484. X  }
  1485. X
  1486. X  $ans = $shead[3];
  1487. X  local($type, $rdlength, $rdata);
  1488. X  local(@return);
  1489. X  while ($ans > 0) {
  1490. X    while (($c = ord(substr($response, $in++, 1))) != 0) {
  1491. X      ($c & 0xc0) != 0xc0 || $in++, last;
  1492. X      $in += $c;
  1493. X    }
  1494. X    $type = substr($response, $in, 2);
  1495. X    $in += 8;
  1496. X    $rdlength = unpack('n', substr($response, $in, 2));
  1497. X    $in += 2;
  1498. X    $rdata = substr($response, $in, $rdlength);
  1499. X    if (unpack('S', $type) == 12) {
  1500. X    return(&label());
  1501. X    }
  1502. X    $in += $rdlength;
  1503. X    $ans--;
  1504. X  }
  1505. X  return 0;
  1506. X}
  1507. X
  1508. Xsub label {
  1509. X  $qname = "";
  1510. X  $c = substr($response, $in, 1); $in++;
  1511. X  $offset = $in;
  1512. X  $forward = 1;
  1513. X  loop: while ($c ne "\000") {
  1514. X    $cc = ord($c);
  1515. X    if (($cc & 0xc0) == 0xc0) {
  1516. X      if ($forward) {
  1517. X        $forward = 0;
  1518. X        $in = $offset + 1;
  1519. X      }
  1520. X      $offset = ($cc - 192) * 256 + ord(substr($response, $offset, 1));
  1521. X    }
  1522. X    else {
  1523. X      $qname = $qname . substr($response, $offset, $cc) . "."; $offset += $cc;
  1524. X    }
  1525. X    $c = substr($response, $offset, 1); $offset++;
  1526. X  }
  1527. X  if ($forward) {
  1528. X    $in = $offset;
  1529. X  }
  1530. X  chop($qname);
  1531. X  print "$qname\n";
  1532. X}
  1533. X
  1534. X1;
  1535. END_OF_FILE
  1536. if test 4269 -ne `wc -c <'resolver.pl'`; then
  1537.     echo shar: \"'resolver.pl'\" unpacked with wrong size!
  1538. fi
  1539. chmod +x 'resolver.pl'
  1540. # end of 'resolver.pl'
  1541. fi
  1542. if test -f 'newgetopt.pl' -a "${1}" != "-c" ; then 
  1543.   echo shar: Will not clobber existing file \"'newgetopt.pl'\"
  1544. else
  1545. echo shar: Extracting \"'newgetopt.pl'\" \(5713 characters\)
  1546. sed "s/^X//" >'newgetopt.pl' <<'END_OF_FILE'
  1547. X# newgetopt.pl -- new options parsing     #-*-perl-*-
  1548. X
  1549. X# SCCS Status     : @(#)@ newgetopt.pl    1.7
  1550. X# Author          : Johan Vromans
  1551. X# Created On      : Tue Sep 11 15:00:12 1990
  1552. X# Last Modified By: Johan Vromans
  1553. X# Last Modified On: Sun Oct 14 14:35:36 1990
  1554. X# Update Count    : 34
  1555. X# Status          : Okay
  1556. X
  1557. X# This package implements a new getopt function. This function adheres
  1558. X# to the new syntax (long option names, no bundling).
  1559. X#
  1560. X# Arguments to the function are:
  1561. X#
  1562. X#  - a list of possible options. These should designate valid perl
  1563. X#    identifiers, optionally followed by an argument specifier ("="
  1564. X#    for mandatory arguments or ":" for optional arguments) and an
  1565. X#    argument type specifier: "n" or "i" for integer numbers, "f" for
  1566. X#    real (fix) numbers or "s" for strings.
  1567. X#
  1568. X#  - if the first option of the list consists of non-alphanumeric
  1569. X#    characters only, it is interpreted as a generic option starter.
  1570. X#    Everything starting with one of the characters from the starter
  1571. X#    will be considered an option.
  1572. X#    Likewise, a double occurrence (e.g. "--") signals end of
  1573. X#    the options list.
  1574. X#    The default value for the starter is "-".
  1575. X#
  1576. X# Upon return, the option variables, prefixed with "opt_", are defined
  1577. X# and set to the respective option arguments, if any.
  1578. X# Options that do not take an argument are set to 1. Note that an
  1579. X# option with an optional argument will be defined, but set to '' if
  1580. X# no actual argument has been supplied.
  1581. X# A return status of 0 (false) indicates that the function detected
  1582. X# one or more errors.
  1583. X#
  1584. X# Special care is taken to give a correct treatment to optional arguments.
  1585. X#
  1586. X# E.g. if option "one:i" (i.e. takes an optional integer argument),
  1587. X# then the following situations are handled:
  1588. X#
  1589. X#    -one -two        -> $opt_one = '', -two is next option
  1590. X#    -one -2        -> $opt_one = -2
  1591. X#
  1592. X# Also, assume "foo=s" and "bar:s" :
  1593. X#
  1594. X#    -bar -xxx        -> $opt_bar = '', '-xxx' is next option
  1595. X#    -foo -bar        -> $opt_foo = '-bar'
  1596. X#    -foo --        -> $opt_foo = '--'
  1597. X#
  1598. X
  1599. X# HISTORY 
  1600. X# 20-Sep-1990        Johan Vromans    
  1601. X#    Set options w/o argument to 1.
  1602. X#    Correct the dreadful semicolon/require bug.
  1603. X
  1604. X
  1605. Xpackage newgetopt;
  1606. X
  1607. X$debug = 0;            # for debugging
  1608. X
  1609. Xsub main'NGetOpt {
  1610. X    local (@optionlist) = @_;
  1611. X    local ($[) = 0;
  1612. X    local ($genprefix) = "-";
  1613. X    local ($error) = 0;
  1614. X    local ($opt, $optx, $arg, $type, $mand, @hits);
  1615. X
  1616. X    # See if the first element of the optionlist contains option
  1617. X    # starter characters.
  1618. X    $genprefix = shift (@optionlist) if $optionlist[0] =~ /^\W+$/;
  1619. X
  1620. X    # Turn into regexp.
  1621. X    $genprefix =~ s/(\W)/\\\1/g;
  1622. X    $genprefix = "[" . $genprefix . "]";
  1623. X
  1624. X    # Verify correctness of optionlist.
  1625. X    @hits = grep ($_ !~ /^\w+([=:][infse])?$/, @optionlist);
  1626. X    if ( $#hits >= 0 ) {
  1627. X    foreach $opt ( @hits ) {
  1628. X        print STDERR ("Error in option spec: \"", $opt, "\"\n");
  1629. X        $error++;
  1630. X    }
  1631. X    return 0;
  1632. X    }
  1633. X
  1634. X    # Process argument list
  1635. X
  1636. X    while ( $#main'ARGV >= 0 ) {        #'){
  1637. X
  1638. X    # >>> See also the continue block <<<
  1639. X
  1640. X    # Get next argument
  1641. X    $opt = shift (@main'ARGV);        #');
  1642. X    print STDERR ("=> option \"", $opt, "\"\n") if $debug;
  1643. X    $arg = undef;
  1644. X
  1645. X    # Check for exhausted list.
  1646. X    if ( $opt =~ /^$genprefix/o ) {
  1647. X        # Double occurrence is terminator
  1648. X        return ($error == 0) if $opt eq "$+$+";
  1649. X        $opt = $';        # option name (w/o prefix)
  1650. X    }
  1651. X    else {
  1652. X        # Apparently not an option - push back and exit.
  1653. X        unshift (@main'ARGV, $opt);        #');
  1654. X        return ($error == 0);
  1655. X    }
  1656. X
  1657. X    # Grep in option list. Hide regexp chars from option.
  1658. X    ($optx = $opt) =~ s/(\W)/\\\1/g;
  1659. X    @hits = grep (/^$optx([=:].+)?$/, @optionlist);
  1660. X    if ( $#hits != 0 ) {
  1661. X        print STDERR ("Unknown option: ", $opt, "\n");
  1662. X        $error++;
  1663. X        next;
  1664. X    }
  1665. X
  1666. X    # Determine argument status.
  1667. X    undef $type;
  1668. X    $type = $+ if $hits[0] =~ /[=:].+$/;
  1669. X    print STDERR ("=> found \"$hits[0]\" for ", $opt, "\n") if $debug;
  1670. X
  1671. X    # If it is an option w/o argument, we're almost finished with it.
  1672. X    if ( ! defined $type ) {
  1673. X        $arg = 1;        # supply explicit value
  1674. X        next;
  1675. X    }
  1676. X
  1677. X    # Get mandatory status and type info.
  1678. X    ($mand, $type) = $type =~ /^(.)(.)$/;
  1679. X
  1680. X    # Check if the argument list is exhausted.
  1681. X    if ( $#main'ARGV < 0 ) {        #'){
  1682. X
  1683. X        # Complain if this option needs an argument.
  1684. X        if ( $mand eq "=" ) {
  1685. X        print STDERR ("Option ", $opt, " requires an argument\n");
  1686. X        $error++;
  1687. X        }
  1688. X        next;
  1689. X    }
  1690. X
  1691. X    # Get (possibly optional) argument.
  1692. X    $arg = shift (@main'ARGV);        #');
  1693. X
  1694. X    # Check if it is a valid argument. A mandatory string takes
  1695. X     # anything. 
  1696. X    if ( "$mand$type" ne "=s" && $arg =~ /^$genprefix/o ) {
  1697. X
  1698. X        # Check for option list terminator.
  1699. X        if ( $arg eq "$+$+" ) {
  1700. X        # Complain if an argument is required.
  1701. X        if ($mand eq "=") {
  1702. X            print STDERR ("Option ", $opt, " requires an argument\n");
  1703. X            $error++;
  1704. X        }
  1705. X        # Push back so the outer loop will terminate.
  1706. X        unshift (@main'ARGV, $arg);    #');
  1707. X        $arg = "";    # don't assign it
  1708. X        next;
  1709. X        }
  1710. X
  1711. X        # Maybe the optional argument is the next option?
  1712. X        if ( $mand eq ":" && $' =~ /[a-zA-Z_]/ ) {
  1713. X        # Yep. Push back.
  1714. X        unshift (@main'ARGV, $arg);    #');
  1715. X        $arg = "";    # don't assign it
  1716. X        next;
  1717. X        }
  1718. X    }
  1719. X
  1720. X    if ( $type eq "n" || $type eq "i" ) { # numeric/integer
  1721. X        if ( $arg !~ /^-?[0-9]+$/ ) {
  1722. X        print STDERR ("Value \"", $arg, "\" invalid for option ",
  1723. X                   $opt, " (numeric required)\n");
  1724. X        $error++;
  1725. X        }
  1726. X        next;
  1727. X    }
  1728. X
  1729. X    if ( $type eq "f" ) { # fixed real number, int is also ok
  1730. X        if ( $arg !~ /^-?[0-9.]+$/ ) {
  1731. X        print STDERR ("Value \"", $arg, "\" invalid for option ",
  1732. X                   $opt, " (real number required)\n");
  1733. X        $error++;
  1734. X        }
  1735. X        next;
  1736. X    }
  1737. X
  1738. X    if ( $type eq "s" ) { # string
  1739. X        next;
  1740. X    }
  1741. X
  1742. X    }
  1743. X    continue {
  1744. X    print STDERR ("=> \$main'opt_$opt = $arg\n") if $debug;
  1745. X    eval ("\$main'opt_$opt = \$arg");
  1746. X    }
  1747. X
  1748. X    return ($error == 0);
  1749. X}
  1750. X1;
  1751. END_OF_FILE
  1752. if test 5713 -ne `wc -c <'newgetopt.pl'`; then
  1753.     echo shar: \"'newgetopt.pl'\" unpacked with wrong size!
  1754. fi
  1755. # end of 'newgetopt.pl'
  1756. fi
  1757. if test -f 'archie.depend' -a "${1}" != "-c" ; then 
  1758.   echo shar: Will not clobber existing file \"'archie.depend'\"
  1759. else
  1760. echo shar: Extracting \"'archie.depend'\" \(750 characters\)
  1761. sed "s/^X//" >'archie.depend' <<'END_OF_FILE'
  1762. X$nsserver = "129.100.1.23";  # the IP address of the domain server    
  1763. X                 # or a hostname with its IP address in your
  1764. X                             # host table. If you have the resolver library
  1765. X                             # in your libc, don't worry about this variable.
  1766. X
  1767. X$startup = './system.archierc'; # The system startup file to be read
  1768. X                # for each job. Used to set host order, 
  1769. X                                # for example.
  1770. X
  1771. X$serverip = '132.206.2.3';         # The IP of the archie server in your area.
  1772. X                                   # Use 128.214.6.100 in Northern Europe?
  1773. X
  1774. X$servername = 'quiche.cs.mcgill.ca'; # The archie address of the archie server.
  1775. X                                     # "nic.funet.fi" in Northern Europe?
  1776. X
  1777. X1;
  1778. END_OF_FILE
  1779. if test 750 -ne `wc -c <'archie.depend'`; then
  1780.     echo shar: \"'archie.depend'\" unpacked with wrong size!
  1781. fi
  1782. # end of 'archie.depend'
  1783. fi
  1784. if test -f 'archie.examples' -a "${1}" != "-c" ; then 
  1785.   echo shar: Will not clobber existing file \"'archie.examples'\"
  1786. else
  1787. echo shar: Extracting \"'archie.examples'\" \(922 characters\)
  1788. sed "s/^X//" >'archie.examples' <<'END_OF_FILE'
  1789. XThe default format string is (between the '--' lines):
  1790. X--
  1791. X%02seq Host %host
  1792. X
  1793. X     Location: %dir
  1794. X       %type %mode %size %date %name
  1795. X
  1796. X--
  1797. XIf you want to specify it on the command line, you do this:
  1798. X
  1799. X$ archie -format '%02seq Host %host\n\n    Location: %dir\n\
  1800. X      %type %mode %date %name' word
  1801. X
  1802. XNotice the single quotes used. This is to prevent the shell from
  1803. Xinterpreting it.
  1804. X
  1805. XIf you want, you can put it in a file, say archie.format, and use the
  1806. X-ffile option:
  1807. X
  1808. X$ archie -ffile archie.format word
  1809. X
  1810. XI usually need only about 10 hits. But the server does not always give
  1811. Xme about 20. So I set the maximum hit to be 40. On command line, I specify
  1812. X
  1813. X$ archie -match 40 vgrind
  1814. X
  1815. XBe careful to single quote any regular expressions you have. Notice:
  1816. Xthe regular expression syntax is out of the control of the program.
  1817. XRead the help file on quiche.cs.mcgill.ca to read for yourself.
  1818. X
  1819. X$ archie -match 40 -reg '*grind*'
  1820. X
  1821. XKhun Yee
  1822. END_OF_FILE
  1823. if test 922 -ne `wc -c <'archie.examples'`; then
  1824.     echo shar: \"'archie.examples'\" unpacked with wrong size!
  1825. fi
  1826. # end of 'archie.examples'
  1827. fi
  1828. if test -f 'DOT.archierc' -a "${1}" != "-c" ; then 
  1829.   echo shar: Will not clobber existing file \"'DOT.archierc'\"
  1830. else
  1831. echo shar: Extracting \"'DOT.archierc'\" \(77 characters\)
  1832. sed "s/^X//" >'DOT.archierc' <<'END_OF_FILE'
  1833. Xmatch    40
  1834. Xformat
  1835. X%02seq %host
  1836. XLocation: %dir
  1837. X%10type %mode %8size %date %name
  1838. END_OF_FILE
  1839. if test 77 -ne `wc -c <'DOT.archierc'`; then
  1840.     echo shar: \"'DOT.archierc'\" unpacked with wrong size!
  1841. fi
  1842. # end of 'DOT.archierc'
  1843. fi
  1844. if test -f 'system.archierc' -a "${1}" != "-c" ; then 
  1845.   echo shar: Will not clobber existing file \"'system.archierc'\"
  1846. else
  1847. echo shar: Extracting \"'system.archierc'\" \(122 characters\)
  1848. sed "s/^X//" >'system.archierc' <<'END_OF_FILE'
  1849. Xmatch 40
  1850. Xdomain  ca edu com gov net de se nl fi au nz
  1851. Xformat
  1852. X%02seq %host
  1853. XLocation: %dir
  1854. X%10type %mode %8size %date %name
  1855. END_OF_FILE
  1856. if test 122 -ne `wc -c <'system.archierc'`; then
  1857.     echo shar: \"'system.archierc'\" unpacked with wrong size!
  1858. fi
  1859. # end of 'system.archierc'
  1860. fi
  1861. echo shar: End of shell archive.
  1862. exit 0
  1863.  
  1864. exit 0 # Just in case...
  1865.